perm filename POKER[206,DEK] blob sn#038638 filedate 1973-05-02 generic text, type T, neo UTF8

(DEFPROP POKLIS
 (POKLIS POKER POKE TOPCARD BOTCARD DUPCARD DUPC FLUSH STRAIGHT NODUP TWODUP)
VALUE)

(DEFPROP POKER
 (LAMBDA NIL (POKE (GETHAND 5)))
EXPR)

(DEFPROP POKE
 (LAMBDA(HAND)
  (COND	((AND (FLUSH HAND) (STRAIGHT HAND) (EQ (TOPCARD HAND) 14)) (QUOTE (ROYAL FLUSH)))
	((DUPCARD HAND HAND 4) (QUOTE (4 OF A KIND)))
	((AND (FLUSH HAND) (STRAIGHT HAND)) (QUOTE (STRAIGHT FLUSH)))
	((AND (DUPCARD HAND HAND 3) (DUPCARD HAND HAND 2)) (QUOTE (FULL HOUSE)))
	((FLUSH HAND) (QUOTE (FLUSH)))
	((STRAIGHT HAND) (QUOTE (STRAIGHT)))
	((DUPCARD HAND HAND 3) (QUOTE (3 OF A KIND)))
	((TWODUP NIL HAND HAND) (QUOTE (TWO PAIR)))
	((DUPCARD HAND HAND 2) (QUOTE (PAIR)))
	(T (QUOTE (BUST)))))
EXPR)

(DEFPROP TOPCARD
 (LAMBDA (HAND) (COND ((NULL (CDR HAND)) (CADAR HAND)) (T (MAX (CADAR HAND) (TOPCARD (CDR HAND))))))
EXPR)

(DEFPROP BOTCARD
 (LAMBDA (HAND) (COND ((NULL (CDR HAND)) (CADAR HAND)) (T (MIN (CADAR HAND) (BOTCARD (CDR HAND))))))
EXPR)

(DEFPROP DUPCARD
 (LAMBDA (HAND REM N) (COND ((NULL REM) NIL) ((EQ N (DUPC (CADAR REM) HAND)) T) (T (DUPCARD HAND (CDR REM) N))))
EXPR)

(DEFPROP DUPC
 (LAMBDA(CARD HAND)
  (COND ((NULL HAND) 0) ((EQ CARD (CADAR HAND)) (ADD1 (DUPC CARD (CDR HAND)))) (T (DUPC CARD (CDR HAND)))))
EXPR)

(DEFPROP FLUSH
 (LAMBDA (HAND) (COND ((NULL (CDR HAND)) T) (T (AND (EQ (CAAR HAND) (CAADR HAND)) (FLUSH (CDR HAND))))))
EXPR)

(DEFPROP STRAIGHT
 (LAMBDA (HAND) (AND (EQ (DIFFERENCE (TOPCARD HAND) (BOTCARD HAND)) 4) (NODUP HAND)))
EXPR)

(DEFPROP NODUP
 (LAMBDA (HAND) (COND ((NULL HAND) T) ((EQ 1 (DUPC (CADAR HAND) HAND)) (NODUP (CDR HAND))) (T NIL)))
EXPR)

(DEFPROP TWODUP
 (LAMBDA(CARD REM HAND)
  (COND	((NULL REM) NIL)
	((EQ 2 (DUPC (CADAR REM) HAND))
	 (COND ((OR (NULL CARD) (EQ CARD (CADAR REM))) (TWODUP (CADAR REM) (CDR REM) HAND)) (T T)))
	(T (TWODUP CARD (CDR REM) HAND))))
EXPR)